home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / DATABASE / PUSHBU.ZIP;1 / PUSHBU.PRG < prev    next >
Encoding:
Text File  |  1992-06-06  |  8.0 KB  |  258 lines
  1. /*-------------------------------------------------------------------------*
  2.  
  3.              SWIS -- THE STARBUCK WINDOWED INFORMATION SYSTEM(c)
  4.                         Copyright 1990, 1991, 1992
  5.                   by Starbuck & Staff, Tarzana, California
  6.                 SWIS(tm) is the trademark of Starbuck & Staff
  7.  
  8.                                   NOTICE:
  9.  
  10.     Place in the public domain by the author on 03/18/92.  No warranties
  11.     of any kind expressed or implied.  Freeware.
  12.  
  13.  
  14. *--------------------------------------------------------------------------*
  15.  
  16.     Title.........:  PUSH-BUTTONS WITH POP-OUT ACTION
  17.  
  18.     Description...:  Keyboard activated push-buttons which respond to
  19.                      cursor movement, enter-key and trigger key input.
  20.                      When a button is selected, the selection is
  21.                      displayed on screen with a push-down, pop-up action.
  22.  
  23.     Author........:  Wendy Starbuck
  24.  
  25.  
  26. *--------------------------------------------------------------------------*/
  27. /*
  28.  
  29.   Revision by Rey Bango 70312,2175. 5/20/92
  30.  
  31.   I just expanded a little on Wendy's initial routines so buttons of any
  32.   length could be specified.  The problem before was that you had to make
  33.   sure that the button strings were the same length.  If they weren't, it
  34.   would cause the offset value to be incorrect and the buttons would not
  35.   be spaced properly.
  36.  
  37.   I also added the ability to attach an action to a button.  The action is
  38.   is a codeblock that will be evaluated when the button is pressed.  The
  39.   actions are specified are specified in a seperate array.
  40.  
  41.       Ex:
  42.       Buttons:               Actions:
  43.  
  44.       aArray1 := { ;            aArray2 := { ;
  45.                "Yes", ;                  { || disp_yes() }, ;
  46.                "No"   :                  { || disp_no() }   ;
  47.              }                         }
  48.  
  49.  
  50.   If you don't want to specify an action for a specific button, simply define
  51.   the action with "" or NIL.  The actions are an optional feature.
  52.  
  53.   Lastly, I created a UDC to make implementing the pushbuttons a little
  54.   easier.
  55.  
  56.                                   NOTICE:
  57.  
  58.   Place in the public domain by the author on 05/20/92.  No warranties
  59.   of any kind expressed or implied.  Freeware.
  60.  
  61. */
  62.  
  63. // Include standard headers
  64. #include "box.ch"
  65. #include "inkey.ch"
  66.  
  67. // Define constants
  68. #define  K_SPACE  32
  69. #xcommand @<nRow>, <nCol> GET <nSele> AS PUSHBUTTON START WITH <nStart> ;
  70.                           BUTTONS <aButtons> [ ACTIONS <aActions> ] =>  ;
  71.           <nSele> := Button_Horizon( <nRow>, <nCol>, <nStart>, <aButtons>, <aActions> )
  72.  
  73. func main
  74.  
  75.     local cSaveColor, nAction := 0, nStart := 1
  76.  
  77.     clear screen
  78.     set scoreboard off
  79.  
  80.     cSaveColor := SetColor( "W+/B" )
  81.     @ 0, 0, maxrow(), maxcol() box B_SINGLE + chr(176)
  82.     SetColor( "W+/R" )
  83.     @ 09, 20, 15, 59 box B_SINGLE + space(1)
  84.     @ 11, 25 say "Do you want to push a button?"
  85.  
  86.     while nAction <> 3 .and. lastkey() <> K_ESC
  87.  
  88.        @ 12, 27 get nAction as pushbutton start with nStart      ;
  89.                     buttons { "YES", "MAYBE", "NO" }         ;
  90.                     actions { { || dispmsg( "Say Yes" )   } ,;
  91.                                   "",                            ;
  92.                       { || getout() } }
  93.  
  94.        nStart := nAction
  95.  
  96.     end //while
  97.  
  98.     SetColor( cSaveColor )
  99.     set cursor on
  100.     clear screen
  101.     quit
  102.  
  103. return nil
  104.  
  105.  
  106. /*-------------------------------------------------------------------------*
  107.     Function....:  Button_Horizon
  108.     Description.:  Display push buttons horizontally.
  109. *--------------------------------------------------------------------------*/
  110.  
  111. function Button_Horizon ( nRow, nCol, nSelect, aButton, aActions )
  112.  
  113.     local cColor1, cColor2, cColor3, cSaveColor
  114.     local x, nNum, nOffSet, cSelect, lExit, nPop, cTrigger := ""
  115.  
  116.     // Setup the button colors
  117.     cSaveColor := setcolor()
  118.     cColor1 := "N/" + Substr( cSaveColor, At( "/", cSaveColor )+1 )
  119.     cColor2 := "W+/G"
  120.     cColor3 := "N/W"
  121.  
  122.     // Define the trigger keys
  123.     x    := 0
  124.     nNum := len( aButton )
  125.     while nNum > x++
  126.         cTrigger := cTrigger + substr( alltrim( aButton[ x ] ), 1, 1 )
  127.     end
  128.  
  129.     // Define the controls
  130.     set cursor off
  131.  
  132.     nOffSet := 0
  133.     cSelect := ""
  134.     lExit   := .F.
  135.     x       := 1
  136.  
  137.     while .T.
  138.  
  139.         // Display buttons until end of array
  140.         SetColor( cColor1 )
  141.         if nNum >= x
  142.  
  143.             // Graphic Style Button
  144.             if nSelect == x
  145.         // This is the highlighted option...
  146.                 Button_Push( nRow, nCol, nOffSet, aButton[ x ], cColor2, lExit )
  147.         // Store the selected button's offset position...
  148.                 nPop := nOffSet
  149.             else
  150.         // These are the unhighlighted option...
  151.                 Button_Push( nRow, nCol, nOffSet, aButton[ x ], cColor3 )
  152.             endif
  153.  
  154.         // Modified this so that variable length strings could be used
  155.         // as buttons.  I just added the old offset value to the new one
  156.         // that's being created...r.b.
  157.             nOffSet += ( Len( aButton[ x ] ) + 4 )
  158.             x++
  159.  
  160.         else
  161.  
  162.             // If a button has been selected, exit
  163.             if lExit
  164.                 // Handle pop-out action
  165.                 Inkey(.3)
  166.                 Button_Push( nRow, nCol, nPop, aButton[ nSelect ], cColor2 )
  167.                 Inkey(.1)
  168.         // Make sure that they have passed an action array...
  169.         if len( aActions ) >= nSelect .and. valtype( aActions[ nSelect ] ) == "B"
  170.            eval( aActions[ nSelect ] )
  171.         endif
  172.                 exit
  173.             else
  174.                 // Wait for a button press
  175.                 cSelect := Chr( Inkey(0) )
  176.             endif
  177.  
  178.             do case
  179.                case LastKey() == K_ENTER .or. ;
  180.                     LastKey() == K_SPACE
  181.                    lExit := .T.
  182.                case Upper( cSelect ) $ cTrigger // Select trigger key
  183.                    lExit := .T.
  184.                    nSelect := At( Upper( cSelect ), cTrigger )
  185.                case LastKey() == K_LEFT         // Left arrow pressed
  186.                    nSelect := if( nSelect - 1 < 1, nNum, nSelect - 1 )
  187.                case LastKey() == K_RIGHT        // Right arrow pressed
  188.                    nSelect := if( nSelect + 1 > nNum, 1, nSelect + 1 )
  189.                case LastKey() == K_ESC          // Escape out
  190.                    nSelect := 0
  191.                    exit
  192.             endcase
  193.  
  194.             nOffSet := 0
  195.             x       := 1
  196.  
  197.         endif
  198.  
  199.     end
  200.  
  201.     // Housekeeping
  202.     SetColor( cSaveColor )
  203.  
  204. return nSelect
  205.  
  206.  
  207. /*-------------------------------------------------------------------------*
  208.     Function....:  Button_Push
  209.     Description.:  Button - push button style.
  210. *--------------------------------------------------------------------------*/
  211.  
  212. function Button_Push ( nRow, nCol, nOffSet, cName, cColor, lExit )
  213.  
  214.     local nLen := Len( cName )
  215.  
  216.     cColor := if( cColor == NIL, SetColor(), cColor )
  217.     lExit := if( lExit == NIL, .F., lExit )
  218.     nCol := nCol + nOffSet
  219.  
  220.     if lExit
  221.         // push state
  222.         @ nRow+1, nCol+2 say space( nLen + 3 )
  223.         @ nRow+2, nCol+2 say space( nLen + 3 )
  224.         SetColor( cColor )
  225.         @ nRow+1, nCol+3 say " " + cName + " "
  226.     else
  227.         // normal state
  228.         @ nRow+1, nCol+nLen+4 say "‹"
  229.         @ nRow+2, nCol+3 say Replicate( "fl", nLen + 2 )
  230.         SetColor( cColor )
  231.         @ nRow+1, nCol+2 say " " + cName + " "
  232.     endif
  233.  
  234. return (.T.)
  235.  
  236.  
  237. /* EOF: PUSHBU.PRG -----------------------------------------------------*/
  238.  
  239. func dispmsg( x )
  240. local cVar := savescreen( 08, 20, 10, 40 )
  241. local cSaveColor := setcolor()
  242. @ 08, 20, 10, 40 box B_SINGLE + space(1) color "W+/G,GR+/G"
  243. @ 09, 22 say x
  244. inkey( 3 )
  245. restscreen( 08, 20, 10, 40, cVar )
  246. setcolor(cSaveColor)
  247. return nil
  248.  
  249. func getout
  250. local cVar := savescreen( 08, 20, 10, 40 )
  251. local cSaveColor := setcolor()
  252. @ 08, 20, 10, 40 box B_SINGLE + space(1) color "W+/G,GR+/G"
  253. @ 09, 22 say "I'm oughta here!!"
  254. inkey( 3 )
  255. restscreen( 08, 20, 10, 40, cVar )
  256. setcolor(cSaveColor)
  257. return nil
  258.